﻿Imports System.Net
Imports System.Text
Imports System.IO
Imports System.IO.Compression
Imports System.Security.Authentication
Imports System.Security.Cryptography.X509Certificates
Imports System.Net.Security
Imports System.Web
Imports System.Net.Cache

Namespace http

    Public Enum Cookie模型
        默认
        强制使用响应Cookie
        自定义Cookie
    End Enum

    Public Class HttpBase

        '请求使用的COOKIE
        Private _ckRequest As New CookieContainer

        '请求完返回的COOKIE
        Private _ckReturn As New CookieCollection

        '保存上一次的COOKIE
        Private _cookie As String = ""

        '使用的COOKIE模型
        Private _Cookie模型 As Cookie模型

        '代理类
        Private _webProxy As WebProxy

        '是否使用代理
        Private _bUserProxy As Boolean

        '默认使用的浏览器
        Private _userAgent As String = "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)"
        Private _accept As String = "application/x-shockwave-flash, image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-ms-application, application/x-ms-xbap, application/vnd.ms-xpsdocument, application/xaml+xml, application/vnd.ms-excel, */*"

        '自定义COOKIE的事件
        Public Event 获取自定义Cookie(ByVal cookieSource As String, ByRef cookieTarget As String, ByRef cookieContainer As CookieContainer)

#Region "构造方法"

        Public Sub New(ByVal Cookie As Cookie模型)

            _Cookie模型 = Cookie

        End Sub

        Public Sub New(ByVal proxy As WebProxy, ByVal Cookie As Cookie模型)
            _Cookie模型 = Cookie

            _webProxy = proxy
            _bUserProxy = True

        End Sub

#End Region

        Private Function CheckValidationResult(ByVal sender As Object, _
                                               ByVal certificate As X509Certificate, _
                                               ByVal chain As X509Chain, _
                                               ByVal errors As SslPolicyErrors) As Boolean
            Return True

        End Function

        Private Function 获取POSTDATA(ByVal postData As String, Optional ByVal bUrlEncode As Boolean = False) As Byte()

            Return System.Text.Encoding.ASCII.GetBytes(postData)

        End Function

        Private Function 获取POSTDATA(ByVal postData As String, ByVal encode As System.Text.Encoding, Optional ByVal bUrlEncode As Boolean = False) As Byte()

            Return encode.GetBytes(postData)

        End Function

        Public Function 获取网页内容(ByVal url As String, _
                                     ByVal hs As Hashtable, _
                                     Optional ByVal bHttps As Boolean = False, _
                                     Optional ByVal bPost As Boolean = False) As String

            Try
                Dim wbr As HttpWebRequest
                Dim requestUri As New Uri(url)

                '初始化 如果是发送HTTPS请求   
                If bHttps = True OrElse url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then
                    ServicePointManager.ServerCertificateValidationCallback = AddressOf CheckValidationResult
                    wbr = CType(WebRequest.Create(url), HttpWebRequest)
                    wbr.ProtocolVersion = HttpVersion.Version11
                Else
                    wbr = CType(WebRequest.Create(url), HttpWebRequest)
                End If

                '去掉请求的时候多了个100-Continue
                wbr.ServicePoint.Expect100Continue = False
                wbr.Timeout = 15000

                '设置代理
                If _bUserProxy = True Then
                    wbr.Proxy = _webProxy
                End If

                '浏览器跳转
                wbr.AllowAutoRedirect = True

                If bPost Then
                    wbr.Method = "POST"
                    If Not wbr.Method.Equals("POST", StringComparison.OrdinalIgnoreCase) Then
                        wbr.Method = "GET"
                    End If
                Else
                    wbr.Method = "GET"
                End If

                '设置请求HEADER
                If hs.Count > 0 Then

                    If hs.Contains(HttpRequestHeader.Accept) Then
                        wbr.Accept = CStr(hs.Item(HttpRequestHeader.Accept))
                    Else
                        wbr.Accept = _accept
                    End If

                    If hs.Contains(HttpRequestHeader.AcceptEncoding) Then
                        wbr.Headers.Add(HttpRequestHeader.AcceptEncoding, CStr(hs.Item(HttpRequestHeader.AcceptEncoding)))
                    Else
                        wbr.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip, deflate")
                    End If

                    If hs.Contains(HttpRequestHeader.AcceptLanguage) Then
                        wbr.Headers.Add(HttpRequestHeader.AcceptLanguage, CStr(hs.Item(HttpRequestHeader.AcceptLanguage)))
                    Else
                        wbr.Headers.Add(HttpRequestHeader.AcceptLanguage, "en-us")
                    End If

                    If hs.Contains(HttpRequestHeader.ContentType) Then
                        wbr.ContentType = CStr(hs.Item(HttpRequestHeader.ContentType))
                    Else
                        '如果是表单的话
                        If bPost = True Then
                            wbr.ContentType = "application/x-www-form-urlencoded"
                        End If
                    End If

                    If hs.Contains(HttpRequestHeader.Host) Then
                        wbr.Headers.Add(HttpRequestHeader.Host, CStr(hs.Item(HttpRequestHeader.Host)))
                    End If

                    If hs.Contains(HttpRequestHeader.Connection) Then
                        wbr.Headers.Add(HttpRequestHeader.KeepAlive, CStr(hs.Item(HttpRequestHeader.Connection)))
                    Else
                        wbr.Headers.Add(HttpRequestHeader.KeepAlive, "Keep-Alive")
                    End If

                    If hs.Contains(HttpRequestHeader.CacheControl) Then
                        wbr.Headers.Add(HttpRequestHeader.CacheControl, CStr(hs.Item(HttpRequestHeader.CacheControl)))
                    Else
                        wbr.Headers.Add(HttpRequestHeader.CacheControl, "no-cache")
                    End If

                    If hs.Contains(HttpRequestHeader.Referer) Then
                        wbr.Referer = CStr(hs.Item(HttpRequestHeader.Referer))
                    End If

                    If hs.Contains("x-requested-with") Then
                        wbr.Headers.Add("x-requested-with", CStr(hs.Item("x-requested-with")))
                    End If

                    If hs.Contains(HttpRequestHeader.UserAgent) Then
                        wbr.UserAgent = CStr(hs.Item(HttpRequestHeader.UserAgent))
                    Else
                        wbr.UserAgent = _userAgent
                    End If
                End If

                '设置COOKIE 初期必须设置一个CookieContainer 否则不能使用CookieContainer
                Select Case _Cookie模型
                    Case Cookie模型.默认
                        wbr.CookieContainer = _ckRequest

                    Case Cookie模型.强制使用响应Cookie
                        If _ckReturn.Count > 0 Then
                            Dim ckRequest As New CookieContainer
                            For Each ck As Cookie In _ckReturn
                                ck.Domain = requestUri.Host
                                ckRequest.Add(ck)
                            Next
                            wbr.CookieContainer = ckRequest
                        Else
                            '存在不存在必须设置一个空的
                            wbr.CookieContainer = _ckRequest
                        End If
                    Case Cookie模型.自定义Cookie
                        Dim cookieTarget As String = ""
                        Dim cookieContainer As New CookieContainer
                        RaiseEvent 获取自定义Cookie(_cookie, cookieTarget, cookieContainer)
                        wbr.CookieContainer = cookieContainer
                End Select

                '是否POST数据
                If bPost AndAlso wbr.Method.Equals("POST", StringComparison.OrdinalIgnoreCase) Then
                    If hs.Contains("PostData") Then

                        Dim postBytes() As Byte
                        postBytes = 获取POSTDATA(CStr(hs.Item("PostData")), True)
                        Dim postLength As Integer = postBytes.Length
                        wbr.ContentLength = postLength

                        Dim rs As Stream = wbr.GetRequestStream()
                        rs.Write(postBytes, 0, postLength)
                        rs.Close()
                    End If
                End If

                '设置COOKIE 获取响应信息
                Dim wbres As HttpWebResponse = CType(wbr.GetResponse, HttpWebResponse)

                'Cookie模型.强制使用响应Cookie 这个场合的时候才使用
                If _Cookie模型 = Cookie模型.强制使用响应Cookie Then
                    Dim bExist As Boolean = False
                    For Each ck As Cookie In wbres.Cookies
                        bExist = False
                        For index As Integer = 0 To _ckReturn.Count - 1
                            If ck.Name = _ckReturn(index).Name Then
                                _ckReturn(index).Value = ck.Value
                                Exit For
                            End If
                        Next
                        If Not bExist Then
                            _ckReturn.Add(ck)
                        End If
                    Next
                End If
                '目前不使用
                '设置字符串
                _cookie = wbres.Headers("Set-Cookie")

                Return http.HttpUtil.ReadStreamEncodingContent(wbres)

            Catch ex As Exception
                Return ""
            End Try

            Return ""

        End Function

    End Class

End Namespace

